home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / vpi1_330.zip / MEMBERS.PRG < prev    next >
Text File  |  1991-12-30  |  5KB  |  160 lines
  1. ***************************************************************************
  2. **  MEMBERS.PRG
  3. **  (C) Copyright 1990-1992, Sub Rosa Publishing Inc.
  4. **
  5. **  A demonstration program provided VP-Info Level 1 users.
  6. **  This program may be copied freely. If it is used in commercial code,
  7. **  please credit the source, Sub Rosa Publishing Inc.
  8. **
  9. **  MEMBERS is compatible with all current versions of VP-Info.
  10. **
  11. **  This short program offers most of the functionality require for basic
  12. **  list management. Add provisions to delete records and print reports
  13. **  and you have a full-blown application.
  14. **
  15. **  MEMBERS demonstrates the use of a "scratch" file used in tandem with
  16. **  EDIT and BROWSE. This is a simple transaction-mode approach to record
  17. **  maintenance. All 'scratch pad' work is done in the temporary file.
  18. **  The master file is only updated after confidence in the new data
  19. **  is established.
  20. **
  21. **  Note the heavy use of the SELECT command, command redirection and field
  22. **  redirection (i.e., adding #n to a command or field name) to force 
  23. **  VP-Info to work on the intended file. New Info users often go wrong 
  24. **  by ending up in the wrong SELECT area, forgetting that the compiler
  25. **  assumes a SELECT area without knowing which branch of the code
  26. **  execution will follow. Therefore it is a good precaution to specify
  27. **  the SELECT area explicitly.
  28. **
  29. **  Sid Bursten and Bernie Melman
  30. ***************************************************************************
  31. USE#1 members index members
  32. USE#2 membtemp
  33. ON escape
  34.    WINDOW         ;cancel any existing window
  35.    CURSOR 23,0    ;move cursor to bottom line
  36.    SET save on    ;restore normal setting
  37.    CANCEL         ;return to 1> prompt
  38. ENDON
  39. SET save on   ;ensure changes are written to disk (this is default)
  40. SET talk off  ;suppress "NO FIND" messages
  41. IF :color <> 7
  42.    SET color to 62 ; yellow on blue (for variety!?)
  43. ENDIF
  44. DO WHILE t  ;put main menu in an infinite loop
  45.    COLOR :color,0,0,24,79,177  ;fill screen with pattern of character 177
  46. *   177 is a shaded fill character.
  47.    WINDOW 6,16,19,64 double  ;declare space for menu text
  48.    MODE = '?'
  49.    ERASE  ;fills window with blanks
  50.    TEXT
  51.  
  52.             MEMBERS MAIN MENU
  53.  
  54.        0. Exit to Sample Programs Menu
  55.  
  56.        1. Choose a starting record
  57.        2. Browse master file
  58.        3. Edit current record
  59.        4. Edit a new record
  60.        5. Exit to Conversational VP-Info
  61.    ENDTEXT
  62.    CURSOR 12,26   ;positions menu cursor over 1st character of 1st choice
  63.    SELECTION = menu(5,35)  ;five choices (plus 0), bar width 35
  64.    DO CASE
  65.    CASE selection=0
  66.       CHAIN samples
  67.    CASE selection=1 ;choose starting record
  68.       SELECT 1
  69.       PERFORM start_rec
  70.       SET save off  ;only allow changes in option 3
  71.       BROWSE
  72.       SET save on   ;restore standard setting
  73.    CASE selection=2 ;browse master file
  74.       SELECT 1
  75.       SET save off  ;only allow changes in option 3
  76.       BROWSE
  77.       SET save on   ;restore standard setting
  78.    CASE selection=3 ;edit copy of current record
  79.       WINDOW
  80.       PERFORM over2
  81.       SELECT 2
  82.       EDIT
  83.       WINDOW 17,30,22,75 double
  84.       ?? cen('What do you want done with these changes:',45)
  85.       ? '  1. Make changes permanent'
  86.       ? '  2. Add this as a new record to main file'
  87.       ? '  3. Discard the changes'
  88.       CURSOR 18,31
  89.       ans=menu(3,43)
  90.       DO CASE
  91.       CASE ans=1
  92.          PERFORM over1
  93.       CASE ans=2
  94.          APPEND to 1
  95.       ENDCASE
  96.       SELECT 1
  97.    CASE selection=4 ;blank record in temp file
  98.       SELECT 2
  99.       ZAP
  100.       APPEND blank
  101.       FLUSH
  102.       WINDOW
  103.       EDIT
  104.       WINDOW 20,30,22,75 double
  105.       ?? cen('Add this record to the master file (Y/N)?',45)
  106.       CURSOR 21,52
  107.       IF !(chr(inkey()))='Y'
  108.          APPEND to 1
  109.       ENDIF
  110.       SELECT 1
  111.    CASE selection=5   ;exit to 1> prompt
  112.       WINDOW  ;reset window to full screen
  113.       ERASE
  114.       CANCEL
  115.    ENDCASE
  116. ENDDO
  117. *
  118. *               *** END OF MEMBERS.PRG main program module ***
  119. *
  120. PROCEDURE start_rec
  121.    CLEAR gets
  122.    mkey=blank(10)
  123.    ERASE
  124.    TEXT
  125. ENTER ESTIMATE OF LAST NAME -
  126.   up to 10 characters
  127.  LAST NAME: @mkey
  128.    ENDTEXT
  129.    READ
  130.    MKEY = !(trim(mkey)) ;get rid of trailing blanks
  131.    FIND &mkey
  132.    IF #=0 ;no find - so go to next record
  133.       GOTO :near
  134.    ENDIF
  135. ENDPROCEDURE start_rec
  136. *
  137. PROCEDURE over1
  138.    REPLACE cust_no#1    with cust_no#2
  139.    REPLACE lname#1      with lname#2
  140.    REPLACE fname#1      with fname#2
  141.    REPLACE street#1     with street#2
  142.    REPLACE city#1       with city#2
  143.    REPLACE state#1      with state#2
  144.    REPLACE zip#1        with zip#2
  145.    REPLACE home_phone#1 with home_phone#2
  146.    REPLACE work_phone#1 with work_phone#2
  147. ENDPROCEDURE; over1
  148. PROCEDURE over2
  149.    REPLACE cust_no#2    with cust_no#1
  150.    REPLACE lname#2      with lname#1
  151.    REPLACE fname#2      with fname#1
  152.    REPLACE street#2     with street#1
  153.    REPLACE city#2       with city#1
  154.    REPLACE state#2      with state#1
  155.    REPLACE zip#2        with zip#1
  156.    REPLACE home_phone#2 with home_phone#1
  157.    REPLACE work_phone#2 with work_phone#1
  158. ENDPROCEDURE; over2
  159. *                     *** end of MEMBERS.PRG ***
  160.